TOP

LibreOffice Calc に英語で記載された金額

説明

LibreOffice Calc には、ワークシート上に数字を英単語として表示できる組み込み関数がありませんが、次の SpellNum_YouLibreCalc 関数マクロを Basic モジュールに挿入することで、この機能を追加できます。

この関数を使用すると、数値などの数式を使用して、数値を任意の通貨の単語に変換できます。 22.50 と読み取られます "Twenty Two Dollars and Fifty Cents" または "Twenty Two Pesos and Fifty Centavos"

これは、LO Calc を小切手やその他の会計書類に記入するテンプレートとして使用する場合に非常に便利です。



SpellNum_YouLibreCalc 関数の StarBASIC コード

英語で書かれた合計に対する独自の関数を追加するには、メニュー Tools - Macros - Edit Macros... を開き、Module1 を選択し、次のコード テキストを選択したモジュールにコピーします。

  1. Function SpellNum_YouLibreCalc(ByVal MyNumber, Optional CurrNameS, Optional CurrNamePl, Optional CentNameS, Optional CentNamePl, Optional Modifier, Optional CurrPlace, Optional AddZero)  
  2.     'moonexcel.com.ua  
  3.     Dim Place(9) As String     
  4.     Dim FCalc    As Object  
  5.     Dim Dollars, Cents, Temp, DecimalPlace, Count, CalcResult   
  6.       
  7.     If Len(MyNumber) = 0 Then Exit Function     
  8.       
  9.     FCalc = CreateUnoService("com.sun.star.sheet.FunctionAccess")  
  10.       
  11.     If IsMissing(CurrNameS)  Then CurrNameS  = 0  
  12.     If IsMissing(CurrNamePl) Then CurrNamePl = 0  
  13.     If IsMissing(CentNameS)  Then CentNameS  = 0  
  14.     If IsMissing(CentNamePl) Then CentNamePl = 0  
  15.     If IsMissing(Modifier)   Then Modifier   = 0             
  16.     If IsMissing(CurrPlace)  Then CurrPlace  = 0  
  17.     If IsMissing(AddZero)    Then AddZero    = 0  
  18.                  
  19.     If CurrNameS  = 0 Then CurrNameS  = ""              
  20.     If CurrNamePl = 0 Then CurrNamePl = ""  
  21.     If CentNameS  = 0 Then CentNameS  = ""        
  22.     If CentNamePl = 0 Then CentNamePl = ""        
  23.       
  24.     Place(2) = " Thousand "  
  25.     Place(3) = " Million "  
  26.     Place(4) = " Billion "  
  27.     Place(5) = " Trillion "   
  28.   
  29.     MyNumber     = Trim(Str(MyNumber))  
  30.     ValMyNumber  = Val(MyNumber)  
  31.     DecimalPlace = InStr(MyNumber, ".")  
  32.       
  33.     If DecimalPlace > 0 Then        
  34.       If Modifier = 5 Then  
  35.         Cents = GetHundreds(Left(Mid(MyNumber, DecimalPlace + 1) & "000", 3))  
  36.       Else   
  37.         Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))  
  38.       End If          
  39.         
  40.       MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))  
  41.     End If          
  42.            
  43.     Count = 1     
  44.          
  45.     Do While MyNumber <> ""  
  46.         Temp = GetHundreds(Right(MyNumber, 3))            
  47.         If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars            
  48.         If Len(MyNumber) > 3 Then  
  49.             MyNumber = Left(MyNumber, Len(MyNumber) - 3)  
  50.         Else  
  51.             MyNumber = ""  
  52.         End If            
  53.         Count = Count + 1  
  54.     Loop                                              
  55.                                           
  56.     If Modifier = 3 Then  
  57.       CalcResult = FCalc.callFunction("MOD", Array(ValMyNumber, 1))  
  58.       CalcResult = FCalc.callFunction("ROUND", Array(CalcResult, 2))                       
  59.       Cents      = Str(CalcResult * 100) & "/100"   
  60.     End If  
  61.       
  62.     If Modifier = 4 Then          
  63.       CalcResult = FCalc.callFunction("MOD", Array(ValMyNumber, 1))                    
  64.       CalcResult = FCalc.callFunction("ROUND", Array(CalcResult, 3))                        
  65.       Cents      = Str(CalcResult * 1000) & "/1000"                
  66.     End If  
  67.       
  68.     If CurrPlace = 1 Then  
  69.         If Len(Dollars) = 0 Then   
  70.        Dollars =  CurrNamePl & " Zero"  
  71.      ElseIf Dollars = "One" Then  
  72.        Dollars = CurrNameS & " One"  
  73.      Else  
  74.        Dollars = CurrNamePl & " " & Dollars   
  75.      End If        
  76.     Else  
  77.      If Len(Dollars) = 0 Then   
  78.        Dollars = "Zero " & CurrNamePl  
  79.      ElseIf Dollars = "One" Then  
  80.        Dollars = "One " & CurrNameS  
  81.      Else  
  82.        Dollars = Dollars & " " & CurrNamePl          
  83.      End If   
  84.     End If             
  85.       
  86.     LenCents = Len(Cents)    
  87.       
  88.     If CurrPlace = 1 Then           
  89.      If LenCents = 0 Then   
  90.        Cents = CentNamePl & " Zero"  
  91.      ElseIf Cents = "One" Then  
  92.        Cents = CentNamePl & " One"  
  93.      Else  
  94.        Cents = CentNamePl & " " & Cents   
  95.      End If  
  96.     Else  
  97.         If LenCents = 0 Then   
  98.        Cents = "Zero " & CentNamePl  
  99.      ElseIf Cents = "One" Then  
  100.        Cents = "One " & CentNameS  
  101.      Else  
  102.        Cents = Cents & " " & CentNamePl          
  103.      End If        
  104.     End If  
  105.       
  106.     If Modifier <> 2 Then Cents = " and " & Cents        
  107.           
  108.     If LenCents = 0 And AddZero <> 1 Then Cents = ""       
  109.       
  110.     Select Case Modifier  
  111.       Case 1:    SpellNumber = Dollars  
  112.       Case 2:    SpellNumber = Cents  
  113.       Case Else: SpellNumber = Dollars & Cents      
  114.     End Select             
  115.                                 
  116.     SpellNum_YouLibreCalc = FCalc.callFunction("TRIM", Array(SpellNumber))  
  117. End Function  
  118.   
  119.   
  120. Function GetHundreds(ByVal MyNumber)  
  121.     Dim Result As String  
  122.     If Val(MyNumber) = 0 Then Exit Function  
  123.     MyNumber = Right("000" & MyNumber, 3)  
  124.     'Перетворити розряд сотень  
  125.     If Mid(MyNumber, 1, 1) <> "0" Then  
  126.         Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "  
  127.     End If  
  128.     'Перетворити розряди десятків і одиниць  
  129.     If Mid(MyNumber, 2, 1) <> "0" Then  
  130.         Result = Result & GetTens(Mid(MyNumber, 2))  
  131.     Else  
  132.         Result = Result & GetDigit(Mid(MyNumber, 3))  
  133.     End If  
  134.     GetHundreds = Result  
  135. End Function  
  136.   
  137.   
  138. Function GetTens(TensText)  
  139.     Dim Result As String  
  140.     'Обнулити значення тимчасової функції  
  141.     Result = ""  
  142.     'Якщо значення між 10-19...  
  143.     If Val(Left(TensText, 1)) = 1 Then     
  144.         Select Case Val(TensText)  
  145.             Case 10: Result = "Ten"  
  146.             Case 11: Result = "Eleven"  
  147.             Case 12: Result = "Twelve"  
  148.             Case 13: Result = "Thirteen"  
  149.             Case 14: Result = "Fourteen"  
  150.             Case 15: Result = "Fifteen"  
  151.             Case 16: Result = "Sixteen"  
  152.             Case 17: Result = "Seventeen"  
  153.             Case 18: Result = "Eighteen"  
  154.             Case 19: Result = "Nineteen"  
  155.             Case Else  
  156.         End Select  
  157.     Else 'Якщо значення між 20-99...  
  158.         Select Case Val(Left(TensText, 1))  
  159.             Case 2: Result = "Twenty "  
  160.             Case 3: Result = "Thirty "  
  161.             Case 4: Result = "Forty "  
  162.             Case 5: Result = "Fifty "  
  163.             Case 6: Result = "Sixty "  
  164.             Case 7: Result = "Seventy "  
  165.             Case 8: Result = "Eighty "  
  166.             Case 9: Result = "Ninety "  
  167.             Case Else  
  168.         End Select  
  169.         'Отримати своє місце  
  170.         Result = Result & GetDigit(Right(TensText, 1))    
  171.     End If  
  172.     GetTens = Result  
  173. End Function  
  174.   
  175.   
  176. Function GetDigit(Digit)  
  177.     Select Case Val(Digit)  
  178.         Case 1: GetDigit = "One"  
  179.         Case 2: GetDigit = "Two"  
  180.         Case 3: GetDigit = "Three"  
  181.         Case 4: GetDigit = "Four"  
  182.         Case 5: GetDigit = "Five"  
  183.         Case 6: GetDigit = "Six"  
  184.         Case 7: GetDigit = "Seven"  
  185.         Case 8: GetDigit = "Eight"  
  186.         Case 9: GetDigit = "Nine"  
  187.         Case Else: GetDigit = ""  
  188.     End Select  
  189. End Function  

次に、Macro Editor を閉じ、LibreOffice Calc に戻り、任意のセルを選択して新しい関数を使用します。

拡張機能の使用

その後、この関数は LibreOffice Calc で開かれるすべてのファイルで使用できるようになります。